home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctj8407.arc / UCL2.BAS < prev    next >
BASIC Source File  |  1986-09-14  |  7KB  |  165 lines
  1. 100 PRINT "UCL.BAS version 83/05/22" 
  2. 105 REM Copyright C 1983 by Eliezer Naddor
  3. 110 REM Needs UCLEXA.BAS and UCLHEL.BAS
  4. 115 REM UCL parsing algorithm in 9600 by David Naddor 83/04/26
  5. 199 ON ERROR GOTO 9800
  6. 200 DEF FNS$(N)=MID$(STR$(N),2)
  7. 300 DIM C$(12),V(12,9):M9=12:N9=9
  8. 400 REM    1   2   3   4   5   6   7   8
  9. 405 C0$=" COM DIS EXA GET HEL NEW SAV STO"
  10. 410 Q0$=" ADD SUB MUL DIV MIN MAX COM ARI"
  11. 415 P0$=" ELE ROW COL ALL FOR"
  12. 420 C0$="   "+C0$:Q0$="   "+Q0$:P0$="   "+P0$
  13. 425 F0$="###,###.######":F1$="####.##":F2$="####   "
  14. 430 Q1$=CHR$(34):Q2$="'":S1$=",":S2$=" "
  15. 900 PRINT " ";M$
  16. 1000 PRINT:GOSUB 9700:PRINT "UCL? ";
  17. 1005 GOSUB 9600:PRINT:M$="Bad UCL":C$=C$(2)
  18. 1010 C0=INSTR(1,C0$," "+LEFT$(C$(1),3))/4
  19. 1015 ON 1+C0 GOTO 900,1300,2700,1800,2000,1700,1200,2070,9999
  20. 1020 REM          UCL COM  DIS  EXA  GET  HEL  NEW  SAV  STO
  21. 1200 M$="Ready":P0=INSTR(P0$," "+LEFT$(C$,3))/4
  22. 1205 ON 1+P0 GOTO 900,2100,2200,2300,2400,2600
  23. 1210 REM          UCL ELE  ROW  COL  ALL  FOR
  24. 1300 GOSUB 9400:IF J=0 OR N8<>5 THEN 900
  25. 1305 Q0=INSTR(Q0$," "+LEFT$(T$,3))/4:IF Q0=0 OR Q0>=7 THEN 900
  26. 1310 P0=INSTR(P0$," "+LEFT$(C$,3))/4
  27. 1315 IF P0<>2 AND P0<>3 THEN 900 ELSE  M$="Done"
  28. 1320 ON P0-1 GOTO 3100,3200
  29. 1325 REM          ROW  COL
  30. 1700 IF N8=1 THEN C$="COM" ELSE IF C$="ALL" THEN T1$="":T2$="9998":GOTO 1715
  31. 1705 Q0=INSTR(Q0$," "+LEFT$(C$,3))/4-6:IF Q0<=0 THEN 900
  32. 1710 T1$=FNS$(1000*Q0+999):T2$=FNS$(1000*Q0+1999)
  33. 1715 C$="UCLHEL.BAS":GOTO 1850
  34. 1800 IF N8=1 THEN C$="EXA" ELSE IF C$="ALL" THEN T1$="":T2$="9998":GOTO 1815
  35. 1805 C0=INSTR(C0$," "+LEFT$(C$,3))/4:IF C0=0 THEN 900
  36. 1810 T1$=FNS$(1000*C0-1):T2$=FNS$(1000*C0+999)
  37. 1815 C$="UCLEXA.BAS"
  38. 1850 OPEN C$ FOR INPUT AS #1
  39. 1855 IF LEN(T1$)<=3 THEN T1$=""
  40. 1860 LINE INPUT #1,T$:IF T$<T1$ THEN 1860
  41. 1865 IF T$<T2$ THEN PRINT MID$(T$,7):GOTO 1860
  42. 1870 CLOSE 1:GOTO 1000
  43. 2000 IF INSTR(C$,".")>0 THEN 2050 ELSE RESTORE
  44. 2005 READ S0$:IF INSTR(S0$,C$)=0 THEN M$="No data set "+C$:GOTO 900
  45. 2010 READ S$,R9,C9,V$:FOR R=0 TO R9
  46. 2015 FOR C=0 TO C9:READ V(R,C):NEXT C
  47. 2020 NEXT R:IF S$<>C$ THEN 2010 ELSE GOSUB 9300:GOTO 2090
  48. 2050 OPEN C$ FOR INPUT AS #1:INPUT #1,S$,R9,C9,V$
  49. 2055 FOR R=0 TO R9:LINE INPUT #1,L$:N8=0:GOSUB 9610
  50. 2060 FOR C=0 TO C9:V(R,C)=VAL(C$(C+1)):NEXT C
  51. 2065 NEXT R:CLOSE 1:GOSUB 9300:GOTO 2090
  52. 2070 IF INSTR(C$,".")=0 THEN 900 ELSE OPEN C$ FOR OUTPUT AS #2
  53. 2075 WRITE #2,C$,R9,C9,V$
  54. 2080 FOR R=0 TO R9:FOR C=0 TO C9-1:PRINT #2,FNS$(V(R,C));",";
  55. 2085 NEXT C:PRINT #2,FNS$(V(R,C9)):NEXT R:CLOSE 2
  56. 2090 M$="Data set "+C$+" ready":GOTO 900
  57. 2100 IF N8=5 THEN 2120
  58. 2105 PRINT " Row,Col,Val"
  59. 2110 GOSUB 9600:IF LEFT$(C$(1),3)="STO" THEN 900
  60. 2115 IF N8<>3 THEN 2105
  61. 2120 R2=VAL(C$(N8-2)):C2=VAL(C$(N8-1))
  62. 2125 V(R2,C2)=VAL(C$(N8)):IF R2>R9 THEN R9=R2
  63. 2130 IF C2>C9 THEN C9=C2
  64. 2135 IF N8=3 THEN 2110 ELSE GOTO 900
  65. 2200 T$=C$(3):GOSUB 9500:R1=G1:R2=G2:IF R2>R9 THEN R9=R2
  66. 2205 GOTO 2500
  67. 2300 T$=C$(3):GOSUB 9500:C1=G1:C2=G2:IF C2>C9 THEN C9=C2
  68. 2305 FOR C=C1 TO C2
  69. 2310 PRINT R9;"values in col";C;"? ";
  70. 2315 GOSUB 9600:IF N8<>R9 THEN 2310
  71. 2320 FOR R=1 TO R9:V(R,0)=1:V(R,C)=VAL(C$(R)):NEXT R
  72. 2325 NEXT C:GOTO 900
  73. 2400 PRINT "Set,Rows,Cols,Title";"? ";
  74. 2405 GOSUB 9600:IF N8<>4 THEN 2400
  75. 2410 S$=C$(1):R9=VAL(C$(2)):C9=VAL(C$(3))
  76. 2415 V$=C$(4):R1=1:R2=R9:GOSUB 9300
  77. 2500 FOR R=R1 TO R2:V(R,0)=1
  78. 2505 PRINT C9;"values in row";R;"? ";
  79. 2510 GOSUB 9600:IF N8<>C9 THEN 2505
  80. 2515 FOR C=1 TO C9:V(0,C)=1:V(R,C)=VAL(C$(C)):NEXT C
  81. 2520 NEXT R:GOTO 900
  82. 2600 M$="Bad format":C$=C$(N8)
  83. 2605 IF INSTR(F0$,C$)=0 GOTO 900 ELSE F1$=C$:F2$=C$
  84. 2610 J=INSTR(C$,".")
  85. 2615 IF J>0 THEN F2$=LEFT$(F1$,J-1)+SPACE$(LEN(F1$)-J+1)
  86. 2620 M$=F1$+" noted":GOTO 900
  87. 2700 P0=INSTR(1,P0$," "+LEFT$(C$,3))/4
  88. 2704 ON 1+P0 GOTO 900,2710,2720,2730,2740,2770
  89. 2706 REM          UCL ELE  ROW  COL  ALL  FOR
  90. 2710 R1=VAL(C$(3)):R2=R1:C1=VAL(C$(4)):C2=C1:GOTO 2750
  91. 2720 T$=C$(3):GOSUB 9500:R1=G1:R2=G2
  92. 2722 IF N8<=4 THEN C1=1:C2=C9:GOTO 2750
  93. 2724 T$=C$(5):GOSUB 9500:C1=G1:C2=G2:GOTO 2750
  94. 2730 T$=C$(3):GOSUB 9500:C1=G1:C2=G2
  95. 2732 IF N8<=4 THEN R1=1:R2=R9:GOTO 2750
  96. 2734 T$=C$(5):GOSUB 9500:R1=G1:R2=G2:GOTO 2750
  97. 2740 R1=1:R2=R9:C1=1:C2=C9
  98. 2742 PRINT "Data set = ";S$;"  Rows =";R9;" Cols =";C9;" Title = ";V$:PRINT
  99. 2750 IF R2>R9 OR C2>C9 THEN 900 ELSE PRINT "   Col";
  100. 2752 FOR C=C1 TO C2:IF V(0,C)>0 THEN PRINT USING F2$;C;
  101. 2754 NEXT C:PRINT:PRINT "Row"
  102. 2756 FOR R=R1 TO R2:IF V(R,0)=0 THEN 2766 ELSE PRINT USING "###   ";R;
  103. 2758 FOR C=C1 TO C2:IF V(0,C)=0 THEN 2764
  104. 2760 V=V(R,C):IF V=INT(V) THEN T$=F2$ ELSE T$=F1$
  105. 2762 PRINT USING T$;V;
  106. 2764 NEXT C:PRINT
  107. 2766 NEXT R:GOTO 1000
  108. 2770 M$="Format = "+F1$:GOTO 900
  109. 3100 R1=VAL(C$(3)):R2=VAL(C$(4)):R3=VAL(C$(5))
  110. 3105 FOR C=1 TO C9:V1=V(R1,C):V2=V(R2,C)
  111. 3110 GOSUB 3900:V(R3,C)=V3:NEXT C:V(R3,0)=1
  112. 3115 IF R3>R9 THEN R9=R3
  113. 3120 GOTO 900
  114. 3200 C1=VAL(C$(3)):C2=VAL(C$(4)):C3=VAL(C$(5))
  115. 3205 FOR R=1 TO R9:V1=V(R,C1):V2=V(R,C2)
  116. 3210 GOSUB 3900:V(R,C3)=V3:NEXT R:V(0,C3)=1
  117. 3215 IF C3>C9 THEN C9=C3
  118. 3220 GOTO 900
  119. 3900 ON Q0 GOTO 3910,3920,3930,3940,3950,3960
  120. 3902 REM        ADD  SUB  MUL  DIV  MAX  MIN
  121. 3910 V3=V1+V2:RETURN
  122. 3920 V3=V1-V2:RETURN
  123. 3930 V3=V1*V2:RETURN
  124. 3940 V3=V1/V2:RETURN
  125. 3950 IF V1<V2 THEN V3=V1 ELSE V3=V2
  126. 3955 RETURN
  127. 3960 IF V1<V2 THEN V3=V2 ELSE V3=V1
  128. 3965 RETURN
  129. 9300 FOR R=R9+1 TO M9:V(R,0)=0:NEXT R
  130. 9305 FOR C=C9+1 TO N9:V(0,C)=0:NEXT C:RETURN
  131. 9400 T$=C$(1):J=INSTR(T$,"/")
  132. 9405 IF J>0 THEN T$=MID$(T$,J+1)
  133. 9410 RETURN
  134. 9500 J=INSTR(2,T$,"-")
  135. 9505 IF J=0 THEN G1=VAL(T$):G2=G1
  136. 9510 IF J>0 THEN G1=VAL(LEFT$(T$,J-1)):G2=VAL(MID$(T$,J+1))
  137. 9515 RETURN
  138. 9600 LINE INPUT L$:N8=0
  139. 9610 P=1:IF L$="" THEN RETURN
  140. 9615 Q1=INSTR(P,L$+Q1$,Q1$):Q2=INSTR(P,L$+Q2$,Q2$):IF Q2<Q1 THEN Q1=Q2
  141. 9620 S1=INSTR(P,L$+S1$,S1$):S2=INSTR(P,L$+S2$,S2$):IF S2<S1 THEN S1=S2
  142. 9625 IF Q1>=S1 THEN 9640
  143. 9630 T$=MID$(L$,Q1,1):L$=LEFT$(L$,Q1-1)+MID$(L$,Q1+1):P=INSTR(P,L$,T$)
  144. 9635 IF P=0 THEN S1=LEN(L$)+1 ELSE L$=LEFT$(L$,P-1)+MID$(L$,P+1):GOTO 9615
  145. 9640 X$=LEFT$(L$,S1-1):L$=MID$(L$,S1+1):IF X$>"" THEN N8=N8+1:C$(N8)=X$
  146. 9645 GOTO 9610
  147. 9700 P7=P7+1:PRINT "[";FNS$(P7);"] ";
  148. 9705 PRINT DATE$;" ";TIME$:RETURN
  149. 9800 PRINT "ERR = ";ERR;"in line";ERL
  150. 9805 STOP:RESUME 1000
  151. 9900 REM S$=Set,R9=Rows,C9=Colms,V$=Title
  152. 9905 DATA AB
  153. 9910 DATA A,3,5,"Stores and items"
  154. 9911 DATA 1,  1, 1, 1, 0, 1
  155. 9912 DATA 1, 20,35,12,37,59
  156. 9913 DATA 1,  8,20, 4,42,60
  157. 9914 DATA 0, 22,33,18,27,49
  158. 9920 DATA B,4,3,"Quantity, cost, price"
  159. 9921 DATA 1, 1, 1,    1
  160. 9922 DATA 1, 3, 4,    7
  161. 9923 DATA 1, 6,12.50,18.00
  162. 9924 DATA 1, 3,25.35,35.75
  163. 9925 DATA 1,12,15.00,28.15
  164. 9999 IF N8=2 THEN CHAIN C$
  165.